home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 5 / Amiga Tools 5.iso / tools / developer-tools / andere sprachen / oberonv4 / oberon-src / system / amiga.mod (.txt) next >
Encoding:
Oberon Text  |  1996-04-11  |  28.1 KB  |  815 lines
  1. Syntax20b.Scn.Fnt
  2. ParcElems
  3. Alloc
  4. Syntax24b.Scn.Fnt
  5. Syntax10.Scn.Fnt
  6. Syntax10b.Scn.Fnt
  7. Syntax10i.Scn.Fnt
  8. FoldElems
  9. Syntax16.Scn.Fnt
  10. Syntax12.Scn.Fnt
  11. (* AMIGA *)
  12. MODULE Amiga;
  13.     Data types, constants, variables, and procedures used to interface
  14.     to the Amiga OS, and to link various high-level modules together.
  15. IMPORT
  16.     SYSTEM,  A:=AmigaAsl, D:=AmigaDos, E:=AmigaExec, G:=AmigaGraphics,
  17.     I:=AmigaIntuition, U:=AmigaUtility, T:=AmigaTimer;
  18. CONST
  19.         These default values are used, if no Oberon4Amiga environment
  20.         variable was found.
  21.     defaultHeight =800;
  22.     defaultWidth = 1024;
  23.     defaultDepth = 4;
  24.     maxDepth = 16;
  25.         The name of the environment variable used. envarcName is
  26.         used for pre V39 AmigaOS, where the copy in the ENVARC:
  27.         directory is not made automatically by SetEnv.
  28.     envName = "Oberon4Amiga";
  29.     envarcName = "ENVARC:Oberon4Amiga";
  30.         The first value of the environment variable contains a version
  31.         field. This is the current version.
  32.     infoVersion = 4;
  33.     pointerSize = 8+4*2;
  34.         The title of the screen, and also the copyright notice appearing
  35.         in the Log on system startup.
  36.     screenTitle = "Oberon for Amiga(TM) Version 4 V1.2, 11 April 1996";
  37.     TrapErr* = 0; ExceptionErr* = 1; SystemErr* = 2;    (** values for ErrorFrame.type *)
  38.         The sizes for the ChipMemPool
  39.      PoolPuddleSize = 32768; PoolThreshSize = PoolPuddleSize DIV 2;
  40.     Absolute=LONGINT;
  41.     Module=LONGINT;
  42.     NewProc*=PROCEDURE(tag:LONGINT):LONGINT;
  43.         The content of the environment varibale. Currently it is
  44.         stored binary, as is. All but the version field contain values
  45.         needed for opening the initial screen.
  46.     Info=RECORD
  47.         version:LONGINT;
  48.         displayID:LONGINT;
  49.         height:INTEGER;
  50.         width:INTEGER;
  51.         depth:INTEGER;
  52.         oscan:LONGINT;
  53.         autoScroll:BOOLEAN
  54.     END;
  55.         Real pointers declarations. The Amiga* modules only
  56.         export these pointer types as LONGINT, to avoid
  57.         problems with the garbage collection.
  58.     ProcessPtr=POINTER TO D.Process;
  59.     ScreenPtr=POINTER TO I.Screen;
  60.     WindowPtr=POINTER TO I.Window;
  61.     RPPtr=POINTER TO G.RastPort;
  62.     IOExtTimerPtr = POINTER TO T.TimeRequest;
  63.         This is the Amiga specific way to store an Oberon
  64.         pattern.
  65.     PatternInfoPtr*= POINTER TO PatternInfo;
  66.     PatternInfo*= RECORD
  67.         modulo*: INTEGER;
  68.         w*, h*: SHORTINT;
  69.         data*: LONGINT; (* Pointer to individual pattern in chip mem. This pointer is used for patterns and Oberon fonts. *)
  70.         offset*: INTEGER; (* Offset to individual pattern in chip mem. This offset is used for Amiga fonts. *)
  71.     END;
  72.         characters are patterns with additional informations needed by the
  73.         Display.GetChar routine. They are not part of Patterns, because they are
  74.         of now use as soon, as the character was "transformed" into a
  75.         simple pattern by Display.GetChar.
  76.     CharInfo*=RECORD (PatternInfo) (* Font related character info *)
  77.         dx*, x*, y*: SHORTINT
  78.     END;
  79.         This is the Amiga specific representation of a font. Data and size point
  80.         to a contiguos memory block which contains all character data (as they
  81.         are build by the diskfont.library).
  82.     Font*= POINTER TO FontInfo;
  83.     FontInfo*= RECORD
  84.         data*: LONGINT; (* Pointer to character data block in chip mem. *)
  85.         size*: LONGINT; (* size of data block *)
  86.         info*: ARRAY 256 OF CharInfo
  87.     END;
  88.         This contains the information needed as starting point to
  89.         build a trap viewer.
  90.     ErrorFrame*= RECORD
  91.         PC-: LONGINT;    (** PC value *)
  92.         SP-: LONGINT;    (** Stack Pointer *)
  93.         FP-: LONGINT;    (** Frame Pointer *)
  94.         type-: LONGINT;    (** type of error: TrapErr, ExceptionErr, SystemErr, 3 = Assertion, 4 = BreakPoint, 5 = Explicit *)
  95.         val-: LONGINT    (** type = TrapErr => trap number; type = ExceptionErr => exception mask (SET) *)
  96.     END;
  97.         Through this procedure variables, the routines from OLoad are called.
  98.         For this to work, OLoad will patch in the address of a procedure into
  99.         this variable. This can obviously work only, if the offset in memory
  100.         of this variable is known.
  101.         Therefore it is VERY IMPORTANT, that these variables remains the first
  102.         declared variables in the module, and thus start at offset -4.
  103.         The two guard variables are filled with some predefined values by OLoad
  104.         so that on module initialisation it can be verifyed, if the variables have
  105.         moved in respect to what OLoad expects .
  106.     guard1:LONGINT;
  107.     loaderCall:PROCEDURE();
  108.     guard2:LONGINT;
  109.         These variables export the window and rast port which have to be used
  110.         for the Oberon screen, as well as their dimensions.
  111.     Depth-:INTEGER;
  112.     Height-:INTEGER;
  113.     Width-:INTEGER;
  114.     window-: I.WindowPtr;
  115.     rp-: G.RastPortPtr;
  116.     MainBitMap-: G.BitMapPtr;
  117.         The next two variables allow the customization of two Amiga specific
  118.         behaviours.
  119.         dontConvert inhibits the conversion of ISO-Latin1-Input to the Oberon
  120.         character set convention. This is needed, if an Latin1 document has to be
  121.         edited. This variable is initialised to FALSE.
  122.         useLAltAsMouse enables the usage of the left alt key as a replacement
  123.         for a middle mouse button, when only a two button mouse is available.
  124.         This variable is initialised to TRUE.
  125.     dontConvert*:BOOLEAN;
  126.     useLAltAsMouse*:BOOLEAN;
  127.         This varible is initialised to the screen title. A read only variable is
  128.         exported instead of the screenTitle constant, to avoid the generation
  129.         of a new symbol file just because the string content has changed.
  130.     version-:ARRAY 64 OF CHAR;
  131.     idlePri*:SHORTINT;
  132.     normalPri*:SHORTINT;
  133.         This is the stack pointer to which the trap handler has to
  134.         return. It is remembered in Amiga.Loop and used in ???.
  135.     stackPtr-: LONGINT;
  136.         thinks for the Timer Device
  137.     TimerOpen*: BOOLEAN;
  138.     TimerMP: E.MsgPortPtr;
  139.     TimerIOPtr: E.MessagePtr;
  140.     TicsToWait*: LONGINT;
  141.         Name of the current printer. Will be send to the OberonPrint script
  142.     PrinterName*: ARRAY 64 OF CHAR;
  143.         Threshold for the Color of Pictures to be printed as white, 0<=n<=256
  144.     PictPrintThresh*: INTEGER;
  145.         Define the Type of the Main Loop
  146.     MainLoopType*: BOOLEAN;
  147.         Pointer to Chip-Memory-Pool (used only if exeVersion>=39
  148.     ChipMemPool-: E.MemPoolPtr;
  149.         Flag for the Requester of System.Quit
  150.     UseQuitRequester*: BOOLEAN;
  151.         Arrays for Character Conversion Amiga <-> Oberon
  152.     AtoO, OtoA: ARRAY 256 OF CHAR;
  153.         ???
  154.     oldProcessWindow:I.WindowPtr;
  155.     screen:I.ScreenPtr;
  156.     pointerData:LONGINT;
  157.     Procedures of OLoad are called with register D3 containing the
  158.     address of a variable of type CallData. The first long word of CallData
  159.     contains a function code. The following  long words contain
  160.     parameters as requested by the specific function. Addresses are
  161.     passed whenever a VAR parameter is requested.
  162.     CallData=ARRAY 8 OF LONGINT;
  163. (* Close Timer Device *)
  164. PROCEDURE CloseTimerDevice;
  165. BEGIN
  166.     IF TimerOpen THEN
  167.         E.CloseDevice(TimerIOPtr)
  168.     END;
  169.     IF TimerIOPtr#0 THEN
  170.         E.DeleteIORequest(TimerIOPtr)
  171.     END;
  172.     IF TimerMP#0 THEN
  173.         E.DeleteMsgPort(TimerMP)
  174.     END;
  175.     TimerOpen:=FALSE; TimerMP:=0; TimerIOPtr:=0
  176. END CloseTimerDevice;
  177. (* Open Timer Device *)
  178. PROCEDURE OpenTimerDevice;
  179. BEGIN
  180.     IF ~TimerOpen THEN
  181.         TimerMP:=E.CreateMsgPort();
  182.         IF TimerMP#0 THEN
  183.             TimerIOPtr:=E.CreateIORequest(TimerMP, SIZE(T.TimeRequest));
  184.             IF TimerIOPtr#0 THEN
  185.                 IF E.OpenDevice(T.timerName, T.microHz, TimerIOPtr, {})=0 THEN TimerOpen:=TRUE END
  186.             END
  187.         END;
  188.         IF ~TimerOpen THEN CloseTimerDevice() END
  189. END OpenTimerDevice;
  190. (* Wait sec and micro/1000000 seconds using Timer Device *)
  191. PROCEDURE WaitTime*(sec, micro: LONGINT);
  192.         TimerIO: IOExtTimerPtr;
  193.         r: SHORTINT;
  194. BEGIN
  195.     TimerIO:=SYSTEM.VAL(IOExtTimerPtr, TimerIOPtr);
  196.     TimerIO.command:=T.addRequest;
  197.     TimerIO.time.secs:=sec;
  198.     TimerIO.time.micro:=micro;
  199.     r:=E.DoIO(TimerIOPtr)
  200. END WaitTime;
  201. PROCEDURE -SaveRegs 048H,0E7H,0FFH,0FEH,02AH,04EH;
  202. (* MOVEM D0-D7/A0-A6,-(A7) MOVEA.L A6,A5 *)
  203. PROCEDURE -LoadRegs 04CH,0DFH,07FH,0FFH;
  204. (* MOVEM.L (A7)+,D0-D7/A0-A6 *)
  205. PROCEDURE CallModula(VAR data:CallData);
  206. BEGIN
  207.     SaveRegs;
  208.     SYSTEM.PUTREG(3,SYSTEM.ADR(data));
  209.     loaderCall(); (* The code for this is in OLoad. *)
  210.     LoadRegs
  211. END CallModula;
  212. PROCEDURE Allocate*(VAR adr:LONGINT; size:LONGINT);
  213.     Allocates an Amiga OS memory block. Used by Kernel and Fonts.
  214.     cd:CallData;
  215. BEGIN
  216.     cd[0]:=7;
  217.     cd[1]:=SYSTEM.ADR(adr);
  218.     cd[2]:=size;
  219.     CallModula(cd)
  220. END Allocate;
  221. PROCEDURE Assert*(cond:BOOLEAN; msg:ARRAY OF CHAR);
  222.     Perform an Arts.Assert.
  223.     cd:CallData;
  224. BEGIN
  225.     cd[0]:=10;
  226.     IF cond THEN cd[1]:=1 ELSE cd[1]:=0 END;
  227.     cd[2]:=SYSTEM.ADR(msg);
  228.     CallModula(cd)
  229. END Assert;
  230. PROCEDURE Deallocate*(adr:LONGINT; size:LONGINT);
  231.     Deallocates an Amiga OS memory block. Used by Kernel and Fonts.
  232.     cd:CallData;
  233. BEGIN
  234.     cd[0]:=12;
  235.     cd[1]:=adr;
  236.     cd[2]:=size;
  237.     CallModula(cd)
  238. END Deallocate;
  239. PROCEDURE GetSearchPath*(VAR searchPath: ARRAY OF CHAR);
  240.     Returns the search path which the loader received as
  241.     parameter.
  242.     cd:CallData;
  243. BEGIN
  244.     cd[0]:=17;
  245.     cd[1]:=SYSTEM.ADR(searchPath);
  246.     cd[2]:=LEN(searchPath);
  247.     CallModula(cd)
  248. END GetSearchPath;
  249. PROCEDURE ThisMod*(name:ARRAY OF CHAR; VAR module:Module; VAR res:INTEGER; VAR modules:Module; VAR imported:ARRAY OF CHAR);
  250.     With this routine, Modules.ThisMod accesses the loaders ThisMod
  251.     instead of reimplementing it.
  252.     cd:CallData;
  253. BEGIN
  254.     cd[0]:=4;
  255.     cd[1]:=SYSTEM.ADR(name);
  256.     cd[2]:=SYSTEM.ADR(module);
  257.     cd[3]:=SYSTEM.ADR(res);
  258.     cd[4]:=SYSTEM.ADR(modules);
  259.     cd[5]:=SYSTEM.ADR(imported);
  260.     CallModula(cd)
  261. END ThisMod;
  262. PROCEDURE ThisCommand*(mod:Module; cmdname:ARRAY OF CHAR; VAR adr:Absolute; VAR res:INTEGER);
  263.     With this routine, Modules.ThisCommand accesses the loaders ThisCommand
  264.     instead of reimplementing it.
  265.     cd:CallData;
  266. BEGIN
  267.     cd[0]:=5;
  268.     cd[1]:=mod;
  269.     cd[2]:=SYSTEM.ADR(cmdname);
  270.     cd[3]:=SYSTEM.ADR(adr);
  271.     cd[4]:=SYSTEM.ADR(res);
  272.     CallModula(cd)
  273. END ThisCommand;
  274. PROCEDURE Free*(name:ARRAY OF CHAR; all:BOOLEAN; VAR res:INTEGER; VAR modules:Module);
  275.     With this routine, Modules.Free accesses the loaders Free
  276.     instead of reimplementing it.
  277.     cd:CallData;
  278. BEGIN
  279.     cd[0]:=6;
  280.     cd[1]:=SYSTEM.ADR(name);
  281.     IF all THEN cd[2]:=1 ELSE cd[2]:=0 END;
  282.     cd[3]:=SYSTEM.ADR(res);
  283.     cd[4]:=SYSTEM.ADR(modules);
  284.     CallModula(cd)
  285. END Free;
  286. PROCEDURE Terminate*();
  287.     Calls Arts.Terminate to bringdown Oberon. Show Requester bevor quitting, if Amiga.UseQuitRequester is TRUE.
  288.     cd:CallData;
  289. BEGIN
  290.     IF (~UseQuitRequester) OR
  291.     (I.CallEasyRequest(window, {}, "Oberon System V4 for Amiga", "Do you really want to quit ?","No|Yes")=0) THEN
  292.         cd[0]:=3;
  293.         CallModula(cd)
  294.     END;
  295. END Terminate;
  296. PROCEDURE InstallNew*(proc:NewProc);
  297.     Passes the address of Kernel.SysNew to OLoad, so that
  298.     it can use it to fixx all NEW references.
  299.     cd:CallData;
  300. BEGIN
  301.     cd[0]:=0;
  302.     cd[1]:=SYSTEM.VAL(LONGINT,proc);
  303.     CallModula(cd)
  304. END InstallNew;
  305. PROCEDURE InstallSysNew*(proc:NewProc);
  306.     Passes the address of Kernel.SysNew to OLoad, so that
  307.     it can use it to fixx all SYSTEM.NEW references.
  308.     cd:CallData;
  309. BEGIN
  310.     cd[0]:=1;
  311.     cd[1]:=SYSTEM.VAL(LONGINT,proc);
  312.     CallModula(cd)
  313. END InstallSysNew;
  314. PROCEDURE InstallModuleList*(modList:LONGINT);
  315.     Passes the address of Kernel.module to OLoad, so that
  316.     it can update it, whenever it is needed (ThisMod/Free).
  317.     cd:CallData;
  318. BEGIN
  319.     cd[0]:=13;
  320.     cd[1]:=modList;
  321.     CallModula(cd)
  322. END InstallModuleList;
  323. PROCEDURE TermProcedure*(proc:PROCEDURE);
  324.     Passes the address of Kernel.FinalizeAll to OLoad, so that
  325.     it can call it on termination.
  326.     cd:CallData;
  327. BEGIN
  328.     cd[0]:=8;
  329.     cd[1]:=SYSTEM.VAL(LONGINT,proc);
  330.     CallModula(cd)
  331. END TermProcedure;
  332. PROCEDURE InstallTrapHandler*(p: PROCEDURE);
  333.     Installs trap handler in Arts.TrapStub
  334.     cd:CallData;
  335. BEGIN
  336.     cd[0]:=14;
  337.     cd[1]:=SYSTEM.VAL(LONGINT,p);
  338.     CallModula(cd)
  339. END InstallTrapHandler;
  340. PROCEDURE RestoreTrapHandler*;
  341.     restores old trap handler in Arts.TrapStub
  342.     cd:CallData;
  343. BEGIN
  344.     cd[0]:=15;
  345.     CallModula(cd)
  346. END RestoreTrapHandler;
  347. PROCEDURE GetErrorFrame*(VAR err: ErrorFrame);
  348.     gets trap information from Arts.errorFrame
  349.     cd:CallData;
  350. BEGIN
  351.     cd[0]:=16;
  352.     cd[1]:=SYSTEM.ADR(err);
  353.     CallModula(cd)
  354. END GetErrorFrame;
  355. PROCEDURE SystemHere*;
  356.     Tells loader, that system has come up to the point, that
  357.     it can display itself any error messages.
  358.     cd:CallData;
  359. BEGIN
  360.     cd[0]:=18;
  361.     CallModula(cd)
  362. END SystemHere;
  363. PROCEDURE Turbo*;
  364.     Set task priority high. Used before starting a command.
  365. VAR task: E.TaskPtr; dummy: LONGINT;
  366. BEGIN
  367.     task := E.FindTask(0);
  368.     dummy := E.SetTaskPri(task, normalPri)
  369. END Turbo;
  370. PROCEDURE Idle*;
  371.     Set task priority low. Used after a command finishes and Oberon.Loop resumes.
  372. VAR task: E.TaskPtr; dummy: LONGINT;
  373. BEGIN
  374.     task := E.FindTask(0);
  375.     dummy := E.SetTaskPri(task, idlePri)
  376. END Idle;
  377. PROCEDURE InitColors*;
  378.     Initializes the color table of the screen. Depeding of the
  379.     depth up to the first 16 colors are initialized.
  380.     vp: G.ViewPortPtr; scr: ScreenPtr;
  381. BEGIN
  382.     scr := SYSTEM.VAL(ScreenPtr, screen);
  383.     vp := SYSTEM.VAL(G.ViewPortPtr,SYSTEM.ADR(scr.viewPort));
  384.     G.SetRGB4(vp,0,0,0,0); G.SetRGB4(vp,1,15,15,15);
  385.     IF Depth=2 THEN
  386.         G.SetRGB4(vp,1,5,5,5); G.SetRGB4(vp,2,10,10,10); G.SetRGB4(vp,3,15,15,15)
  387.     ELSIF Depth=3 THEN
  388.         G.SetRGB4(vp,1,15,0,0); G.SetRGB4(vp,2,0,15,0); G.SetRGB4(vp,3,0,0,15);
  389.         G.SetRGB4(vp,4,15,15,0); G.SetRGB4(vp,5,15,0,15); G.SetRGB4(vp,6,0,15,15); G.SetRGB4(vp,7,15,15,15)
  390.     ELSIF Depth>=4 THEN
  391.         G.SetRGB4(vp,1,15,0,0); G.SetRGB4(vp,2,0,15,0);
  392.         G.SetRGB4(vp,3,0,0,15); G.SetRGB4(vp,5,15,0,15);
  393.         G.SetRGB4(vp,4,15,15,0); G.SetRGB4(vp,6,0,15,15);
  394.         G.SetRGB4(vp,7,10,0,0); G.SetRGB4(vp,8,0,9,0);
  395.         G.SetRGB4(vp,9,0,0,9); G.SetRGB4(vp,10,7,0,12);
  396.         G.SetRGB4(vp,11,11,8,0); G.SetRGB4(vp,12,8,8,8);
  397.         G.SetRGB4(vp,13,10,10,10); G.SetRGB4(vp,14,12,12,12); G.SetRGB4(vp,15,15,15,15);
  398.         (* leave the others as they are *)
  399.         IF Depth>4 THEN
  400.             G.SetRGB4(vp,SYSTEM.LSH(1,Depth)-1, 8, 8, 8)
  401.         END
  402. END InitColors;
  403. PROCEDURE Close*;
  404.     Free the custom (= blank) pointer sprite.
  405.     Restore the original window in the process structure.
  406.     Close Oberon window and screen.
  407.     Free Chip-Mem-Pool.
  408.     Close Timer Device
  409.     proc:ProcessPtr;
  410.     scr:ScreenPtr;
  411.     win:WindowPtr;
  412. BEGIN
  413.     IF pointerData#0 THEN
  414.         I.ClearPointer(window);
  415.         IF E.execVersion<39 THEN E.FreeMem(pointerData,pointerSize) END;
  416.         pointerData:=0
  417.     END;
  418.     IF oldProcessWindow#0 THEN
  419.         proc:=SYSTEM.VAL(ProcessPtr,E.FindTask(0));
  420.         proc.windowPtr:=oldProcessWindow;
  421.         oldProcessWindow:=0
  422.     END;
  423.     win := SYSTEM.VAL(WindowPtr, window); scr := SYSTEM.VAL(ScreenPtr, screen);
  424.     IF win#NIL THEN I.CloseWindow(window); win := NIL END;
  425.     IF scr#NIL THEN I.CloseScreen(screen); scr := NIL END;
  426.     window := SYSTEM.VAL(LONGINT, win); screen := SYSTEM.VAL(LONGINT, scr);
  427.     IF ChipMemPool#0 THEN E.DeletePool(ChipMemPool) END;
  428.     IF TimerOpen THEN CloseTimerDevice() END
  429. END Close;
  430. PROCEDURE GetDefaultMode(VAR info:Info; VAR fromEnv:BOOLEAN);
  431.     Initialise info with the values from the environment. If this is not
  432.     possible, use the default sizes, and the screen mode of the workbench
  433.     screen (if available). fromEnv returns FALSE, if the environment wasn't
  434.     found.
  435.     key:LONGINT;
  436.     len:LONGINT;
  437.     scr:ScreenPtr;
  438.     DosV36: BOOLEAN;
  439. BEGIN
  440.     DosV36:=D.dosVersion<=37; (* docu said 36, but testing said 37 *)
  441.     len:=D.GetVar(envName,SYSTEM.ADR(info),SIZE(Info),{D.globalOnly,D.binaryVar,D.dontNullTerm});
  442.     fromEnv:=((DosV36 & (len=SIZE(Info)-1)) OR ((~DosV36) & (len=SIZE(Info)))) & (info.version=infoVersion);
  443.     IF ~fromEnv THEN
  444.         scr:=SYSTEM.VAL(ScreenPtr,I.LockPubScreen(0));
  445.         IF scr#NIL THEN
  446.             key:=G.GetVPModeID(SYSTEM.ADR(scr.viewPort));
  447.             I.UnlockPubScreen(0,SYSTEM.VAL(I.ScreenPtr,scr))
  448.         ELSE
  449.             key:=G.hiresLaceKey
  450.         END;
  451.         info.version:=infoVersion;
  452.         info.displayID:=key;
  453.         info.width:=defaultWidth;
  454.         info.height:=defaultHeight;
  455.         info.depth:=defaultDepth;
  456.         info.oscan:=I.oScanText;
  457.         info.autoScroll:=TRUE
  458. END GetDefaultMode;
  459. PROCEDURE ReadScreenMode*(VAR displayID:LONGINT;
  460.         VAR height, width, depth: INTEGER; VAR oscan:LONGINT; VAR autoScroll:BOOLEAN);
  461.     Read the environment variable, and extract from it all values
  462.     needed for screen initialization. Use the default values, if the
  463.     environment variable doesn't exist, or has a wrong version.
  464.     dummy:BOOLEAN;
  465.     info:Info;
  466. BEGIN
  467.     GetDefaultMode(info,dummy);
  468.     displayID:=info.displayID;
  469.     width:=info.width;
  470.     height:=info.height;
  471.     depth:=info.depth;
  472.     oscan:=info.oscan;
  473.     autoScroll:=info.autoScroll
  474. END ReadScreenMode;
  475. PROCEDURE WriteScreenMode*(displayID:LONGINT;
  476.         height, width, depth: INTEGER; oscan:LONGINT; autoScroll:BOOLEAN);
  477.     Store the screen values into the environment variable. On pre 3.0 Amigas
  478.     write them also to the envarc: files as SetVar won't do it for you.
  479.     dummy:LONGINT;
  480.     dummyB:BOOLEAN;
  481.     f:D.FileHandlePtr;
  482.     info:Info;
  483. BEGIN
  484.     info.version:=infoVersion;
  485.     info.displayID:=displayID;
  486.     info.width:=width;
  487.     info.height:=height;
  488.     info.depth:=depth;
  489.     info.oscan:=oscan;
  490.     info.autoScroll:=autoScroll;
  491.     dummyB:=D.SetVar(
  492.         envName,SYSTEM.ADR(info),SIZE(Info),{D.globalOnly,D.saveVar,D.binaryVar,D.dontNullTerm}
  493.     IF A.aslVersion<39 THEN
  494.         f:=D.Open(envarcName,D.readWrite);
  495.         IF f#0 THEN
  496.             dummy:=D.Write(f,info,SIZE(Info));
  497.             dummyB:=D.Close(f)
  498.         END
  499. END WriteScreenMode;
  500. PROCEDURE ChangeMode2(info:Info);
  501.     Present a screen mode requester prefilled with the values from info.
  502.     Store the returned values into the environment.
  503.     ScreenModeRequesterPtr=POINTER TO A.ScreenModeRequester;
  504.     ok:BOOLEAN;
  505.     screenRequest:ScreenModeRequesterPtr;
  506.     tags:ARRAY 15 OF U.TagItem;
  507. BEGIN
  508.     tags[0].tag:=A.tsmDoAutoScroll;
  509.     tags[0].data:=SYSTEM.VAL(LONGINT,TRUE);
  510.     tags[1].tag:=A.tsmDoDepth;
  511.     tags[1].data:=SYSTEM.VAL(LONGINT,TRUE);
  512.     tags[2].tag:=A.tsmDoHeight;
  513.     tags[2].data:=SYSTEM.VAL(LONGINT,TRUE);
  514.     tags[3].tag:=A.tsmDoOverscanType;
  515.     tags[3].data:=SYSTEM.VAL(LONGINT,TRUE);
  516.     tags[4].tag:=A.tsmDoWidth;
  517.     tags[4].data:=SYSTEM.VAL(LONGINT,TRUE);
  518.     tags[5].tag:=A.tsmInitialAutoScroll;
  519.     IF info.autoScroll THEN
  520.         tags[5].data:=-1
  521.     ELSE
  522.         tags[5].data:=0
  523.     END;
  524.     tags[6].tag:=A.tsmInitialDisplayDepth;
  525.     tags[6].data:=info.depth;
  526.     tags[7].tag:=A.tsmInitialDisplayHeight;
  527.     tags[7].data:=info.height;
  528.     tags[8].tag:=A.tsmInitialDisplayID;
  529.     tags[8].data:=info.displayID;
  530.     tags[9].tag:=A.tsmInitialDisplayWidth;
  531.     tags[9].data:=info.width;
  532.     tags[10].tag:=A.tsmInitialOverscanType;
  533.     tags[10].data:=info.oscan;
  534.     tags[11].tag:=A.tsmScreen;
  535.     tags[11].data:=screen;
  536.     tags[12].tag:=A.tsmMaxDepth;
  537.     tags[12].data:=maxDepth;
  538.     tags[13].tag:=U.done;
  539.     screenRequest:=SYSTEM.VAL(ScreenModeRequesterPtr,A.AllocAslRequest(A.aslScreenModeRequest,tags));
  540.     Assert(screenRequest#NIL,"No ScreenModeRequester");
  541.     tags[0].tag:=U.done;
  542.     ok:=A.AslRequest(SYSTEM.VAL(LONGINT,screenRequest),tags);
  543.     IF ok THEN
  544.         WriteScreenMode(
  545.             screenRequest.displayID,SHORT(screenRequest.displayHeight),SHORT(screenRequest.displayWidth)
  546.             ,screenRequest.displayDepth,screenRequest.overscanType,screenRequest.autoScroll#0
  547.     END;
  548.     A.FreeAslRequest(SYSTEM.VAL(LONGINT,screenRequest));
  549.     screenRequest:=NIL
  550. END ChangeMode2;
  551. PROCEDURE ChangeMode*(VAR res:INTEGER);
  552.     Present screen mode requester if the OS version
  553.     supports it. Used by System.ChangeMode.
  554.     dummy:BOOLEAN;
  555.     info:Info;
  556. BEGIN
  557.     IF A.aslVersion>=38 THEN
  558.         GetDefaultMode(info,dummy);
  559.         ChangeMode2(info);
  560.         res:=0
  561.     ELSE
  562.         res:=1
  563. END ChangeMode;
  564. PROCEDURE DosCmd*(cmd, outName:ARRAY OF CHAR; VAR res:INTEGER);
  565.     Run a program with STDIN set to NIL: and STDOUT set to output.
  566.     in,out:D.FileHandlePtr;
  567.     tags:ARRAY 4 OF U.TagItem;
  568. BEGIN
  569.     in:=D.Open("NIL:",D.oldFile);
  570.     ASSERT(in#0);
  571.     out:=D.Open(outName,D.newFile);
  572.     ASSERT(out#0);
  573.     tags[0].tag:=D.sysInput;
  574.     tags[0].data:=in;
  575.     tags[1].tag:=D.sysOutput;
  576.     tags[1].data:=out;
  577.     tags[2].tag:=D.npCloseOutput;
  578.     tags[2].data:=SYSTEM.VAL(LONGINT,FALSE);
  579.     tags[3].tag:=U.done;
  580.     res:=SHORT(D.System(cmd,tags));
  581.     IF D.Close(out) THEN END;
  582.     IF D.Close(in) THEN END
  583. END DosCmd;
  584. PROCEDURE SwapBits*(b: SYSTEM.BYTE):SYSTEM.BYTE;
  585.     Swaps the bits within a byte [76543210] -> [01234567]
  586.     i:INTEGER;
  587.     in,res:LONGINT;
  588. BEGIN
  589.     res:=0;
  590.     in:=ORD(SYSTEM.VAL(CHAR,b));
  591.     FOR i:=0 TO 7 DO
  592.         res:=res*2+in MOD 2;
  593.         in:=in DIV 2
  594.     END;
  595.     RETURN CHR(res)
  596. END SwapBits;
  597. PROCEDURE ConvertAnsiToOberon*(VAR buf:ARRAY OF CHAR; len:LONGINT);
  598.     Convert ANSI (ISO latin1) Codes to the Oberon font. This conversion
  599.     can be switched off by setting dontConvert:=TRUE.
  600.     i:LONGINT;
  601. BEGIN
  602.     IF dontConvert THEN RETURN END;
  603.     FOR i:=0 TO len-1 DO
  604.         buf[i]:=AtoO[ORD(buf[i])]
  605. END ConvertAnsiToOberon;
  606. PROCEDURE Loop*;
  607.     This is the loop, which the loader calls instead of Oberon.Loop.
  608.     It remembers the current stack pointer before calling Oberon.Loop,
  609.     so the trap handler can return us into the loop, and we can restart
  610.     Oberon.Loop after each trap.
  611.     imported:ARRAY 32 OF CHAR;
  612.     mod,modules:Module;
  613.     oberonLoop:PROCEDURE;
  614.     res:INTEGER;
  615. BEGIN
  616.     ThisMod("Oberon",mod,res,modules,imported);
  617.     Assert(res=0,"Amiga.Loop: Oberon not found");
  618.     ThisCommand(mod,"Loop",SYSTEM.VAL(Absolute,oberonLoop),res);
  619.     Assert(res=0,"Amiga.Loop: Oberon.Loop not found");
  620.     LOOP
  621.         SaveRegs;
  622.         SYSTEM.GETREG(15,stackPtr);
  623.         DEC(stackPtr,4); (* stack pointer value after call of oberonLoop. *)
  624.         oberonLoop;
  625.         LoadRegs
  626. END Loop;
  627. PROCEDURE ConvAtoO*(ch: CHAR): CHAR;    (*<<RD*)
  628.     Convert Char Amiga->Oberon
  629. BEGIN
  630.     IF dontConvert THEN
  631.         RETURN ch
  632.     ELSE
  633.         RETURN AtoO[ORD(ch)]
  634. END ConvAtoO;
  635. PROCEDURE ConvOtoA*(ch: CHAR): CHAR;    (*<<RD*)
  636.     Convert Char Oberon->Amiga
  637. BEGIN
  638.     IF dontConvert THEN
  639.         RETURN ch
  640.     ELSE
  641.         RETURN OtoA[ORD(ch)]
  642. END ConvOtoA;
  643. PROCEDURE InitCharConv;    (*<<RD*)
  644.     Init Arrays for Character Conversion
  645. VAR i: INTEGER;
  646. BEGIN
  647.     (* no conversion for Ascii *)
  648.     FOR i:=0 TO 127 DO
  649.         AtoO[i]:=CHR(i); OtoA[i]:=CHR(i)
  650.     END;
  651.     (* Amiga to Oberon *)
  652.     AtoO[00AH]:=00DX;    AtoO[01CH]:=" ";    AtoO[0B4H]:="'";
  653.     AtoO[0C4H]:="
  654. ";    AtoO[0D6H]:="
  655. ";    AtoO[0DCH]:="
  656. ";    AtoO[0E4H]:="
  657.     AtoO[0EBH]:="
  658. ";    AtoO[0EFH]:="
  659. ";    AtoO[0F6H]:="
  660. ";    AtoO[0FCH]:="
  661.     AtoO[0E2H]:="
  662. ";    AtoO[0EAH]:="
  663. ";    AtoO[0EEH]:="
  664. ";    AtoO[0F4H]:="
  665.     AtoO[0FBH]:="
  666. ";    AtoO[0E0H]:="
  667. ";    AtoO[0E8H]:="
  668. ";    AtoO[0ECH]:="
  669.     AtoO[0F2H]:="
  670. ";    AtoO[0F9H]:="
  671. ";    AtoO[0E1H]:="
  672. ";    AtoO[0E9H]:="
  673.     AtoO[0E7H]:="
  674. ";    AtoO[0F1H]:="
  675. ";    AtoO[0DFH]:="
  676.     (* Oberon to Amiga*)
  677.     OtoA[00DH]:=00AX;    OtoA[01CH]:=000X;
  678.     OtoA[ORD("
  679. ")]:=0C4X;    OtoA[ORD("
  680. ")]:=0D6X;    OtoA[ORD("
  681. ")]:=0DCX;    OtoA[ORD("
  682. ")]:=0E4X;
  683.     OtoA[ORD("
  684. ")]:=0EBX;    OtoA[ORD("
  685. ")]:=0EFX;    OtoA[ORD("
  686. ")]:=0F6X;    OtoA[ORD("
  687. ")]:=0FCX;
  688.     OtoA[ORD("
  689. ")]:=0E2X;    OtoA[ORD("
  690. ")]:=0EAX;    OtoA[ORD("
  691. ")]:=0EEX;    OtoA[ORD("
  692. ")]:=0F4X;
  693.     OtoA[ORD("
  694. ")]:=0FBX;    OtoA[ORD("
  695. ")]:=0E0X;    OtoA[ORD("
  696. ")]:=0E8X;    OtoA[ORD("
  697. ")]:=0ECX;
  698.     OtoA[ORD("
  699. ")]:=0F2X;    OtoA[ORD("
  700. ")]:=0F9X;    OtoA[ORD("
  701. ")]:=0E1X;    OtoA[ORD("
  702. ")]:=0E9X;
  703.     OtoA[ORD("
  704. ")]:=0E7X;    OtoA[ORD("
  705. ")]:=0F1X;    OtoA[ORD("
  706. ")]:=0DFX;
  707. END InitCharConv;
  708. PROCEDURE Init;
  709.     Get the screen infos and initialize the Oberon screen and window.
  710.     Install a blank sprite as pointer. Install the termination procedure for
  711.     all this.
  712.     Initialise the gloabl variables for character conversion and middle
  713.     mouse button replacement.
  714.     fromEnv:BOOLEAN;
  715.     info:Info;
  716.     proc:ProcessPtr;
  717.     scr:ScreenPtr;
  718.     scrrp:RPPtr;
  719.     tags:ARRAY 13 OF U.TagItem;
  720.     win:WindowPtr;
  721.     i: INTEGER;
  722. BEGIN
  723.     version:=screenTitle;
  724.     IF A.aslVersion>=38 THEN
  725.         GetDefaultMode(info,fromEnv);
  726.         IF ~fromEnv THEN
  727.             ChangeMode2(info);
  728.             GetDefaultMode(info,fromEnv)
  729.         END
  730.     ELSE
  731.         GetDefaultMode(info,fromEnv)
  732.     END;
  733.     Depth:=info.depth;
  734.     Height:=info.height;
  735.     Width:=(info.width DIV 8)*8;
  736.     tags[0].tag:=I.saDepth;
  737.     tags[0].data:=Depth;
  738.     tags[1].tag:=I.saHeight;
  739.     tags[1].data:=Height;
  740.     tags[2].tag:=I.saWidth;
  741.     tags[2].data:=Width;
  742.     tags[3].tag:=I.saDisplayID;
  743.     tags[3].data:=info.displayID;
  744.     tags[4].tag:=I.saQuiet;
  745.     tags[4].data:=-1;
  746.     tags[5].tag:=I.saAutoScroll;
  747.     tags[5].data:=-1;
  748.     tags[6].tag:=I.saOverscan;
  749.     tags[6].data:=info.oscan;
  750.     tags[7].tag:=I.saBehind;
  751.     tags[7].data:=-1;
  752.     tags[8].tag:=I.saDetailPen;
  753.     tags[8].data:=0;
  754.     tags[9].tag:=I.saBlockPen;
  755.     tags[9].data:=SYSTEM.LSH(1,Depth)-1;
  756.     tags[10].tag:=I.saTitle;
  757.     tags[10].data:=SYSTEM.ADR(screenTitle);
  758.     (*Interleave Planes have no effect but bring problems with printing PictElems*)
  759.     tags[11].tag:=I.saInterleaved;
  760.     tags[11].data:=-1;
  761.     tags[11].tag:=U.done;
  762.     screen:=I.OpenScreenTags(0(*NIL*),tags); scr := SYSTEM.VAL(ScreenPtr, screen);
  763.     Assert(scr#NIL,"No screen");
  764.     InitColors;
  765.     tags[0].tag:=I.waCustomScreen;
  766.     tags[0].data:= screen;
  767.     tags[1].tag:=I.waIDCMP;
  768.     tags[1].data:=SYSTEM.VAL(LONGINT, {I.rawKey,I.mouseButtons(*,I.mouseMove*)});
  769.     tags[2].tag:=I.waFlags;
  770.     tags[2].data:=SYSTEM.VAL(LONGINT, {I.backDrop,I.borderless,I.activate,I.rmbTrap,I.noCareRefresh(*,I.reportMouse*)});
  771.     tags[3].tag:=U.done;
  772.     window:=I.OpenWindowTags(0(*NIL*),tags); win := SYSTEM.VAL(WindowPtr, window);
  773.     Assert(win#NIL,"No window");
  774.     proc:=SYSTEM.VAL(ProcessPtr,E.FindTask(0));
  775.     oldProcessWindow:=proc.windowPtr;
  776.     proc.windowPtr:=window;
  777.     I.ShowTitle(screen,FALSE);
  778.     IF E.execVersion>=39 THEN
  779.         ChipMemPool:=E.CreatePool({E.memChip}, PoolPuddleSize, PoolThreshSize);
  780.         Assert(ChipMemPool#0, "Can not create memory pool for fonts")
  781.     ELSE
  782.         ChipMemPool:=0
  783.     END;
  784.     IF ChipMemPool#0 THEN
  785.         pointerData:=E.AllocPooled(ChipMemPool, pointerSize);
  786.         FOR i:=0 TO pointerSize-1 DO SYSTEM.PUT(pointerData+i, CHR(0)) END
  787.     ELSE
  788.         pointerData:=E.AllocMem(pointerSize,{E.memChip,E.memClear})
  789.     END;
  790.     rp:=win.rPort;
  791.     I.SetPointer(window,pointerData,2,16,0,0);
  792.     I.ScreenToFront(screen);
  793.     TermProcedure(Close);
  794.     dontConvert:=FALSE;
  795.     useLAltAsMouse:=TRUE;
  796.     idlePri:=-128;
  797.     normalPri:=0;
  798.     OpenTimerDevice();
  799.     TicsToWait:=20000;
  800.     MainLoopType:=TimerOpen; (* Use AmigaLoop if Timer Device is open *)
  801.     scrrp:=SYSTEM.VAL(RPPtr, SYSTEM.ADR(scr.rastPort));
  802.     MainBitMap:=scrrp.bitMap;
  803.     PrinterName:="PrinterOut.ps";
  804.     PictPrintThresh:=128;
  805.     UseQuitRequester:=FALSE;
  806.     InitCharConv
  807. END Init;
  808. BEGIN
  809.     TimerOpen:=FALSE; TimerMP:=0; TimerIOPtr:=0;
  810.     stackPtr:=0;
  811.         Ensure, that OLoad probably guessed right, when patching in loaderCall.
  812.     Assert((guard1=002468ACEH) & (guard2=013579BDFH),"Amiga: wrong loader call guards.");
  813.     Init
  814. END Amiga.
  815.